home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / bin / remsync < prev    next >
Text File  |  2005-12-21  |  48KB  |  2,182 lines
  1. #! /usr/bin/perl
  2. # Generated automatically from remsync.in by configure.
  3. eval "exec /usr/bin/perl -S $0 $*"
  4.     if $running_under_some_shell;
  5.  
  6. # Synchronization tool for remote directories.
  7. # Copyright (C) 1994 Free Software Foundation, Inc.
  8. # Franτois Pinard <pinard@iro.umontreal.ca>, 1994.
  9.  
  10. # This program is free software; you can redistribute it and/or modify
  11. # it under the terms of the GNU General Public License as published by
  12. # the Free Software Foundation; either version 2, or (at your option)
  13. # any later version.
  14.  
  15. # This program is distributed in the hope that it will be useful,
  16. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. # GNU General Public License for more details.
  19.  
  20. # You should have received a copy of the GNU General Public License
  21. # along with this program; if not, write to the Free Software Foundation,
  22. # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23.  
  24. # Parameters, but not meant to be changed.
  25.  
  26. $PACKAGE = "sharutils";        # name of package for this program
  27. $VERSION = "4.2.1";        # version number for the whole package
  28. $PROGRAM = "remsync";        # name of this particular program
  29. $FORMAT = "1.3";        # version of format for files
  30.  
  31. $CONFIG = ".remsync";        # file containing synchronization information
  32. $ARCHIVE = ".remsync.tar.gz";    # default file name of packed synchro. package
  33. $WORKDIR = ".remsync-work";    # directory name of unpacked synchro. package
  34. $ORDERS = "orders";        # file name containaing synchro. directives
  35.  
  36. $DIFF = "/usr/bin/diff";        # GNU diff path
  37. $TAR = "/bin/tar";            # GNU tar path
  38. $SH = "/bin/bash";            # Bash or sh path
  39.  
  40. # Special constants.
  41.  
  42. $NEWLY_CREATED_SCAN = 2;    # Instead of 1, when by remote request
  43.  
  44. # Help strings.
  45.  
  46. $INITIAL_HELP = "$PROGRAM (format $FORMAT) - GNU $PACKAGE $VERSION
  47.   Remote synchronization of files and directories.
  48.  
  49. The following commands are available at *any* \`$PROGRAM\' prompt:
  50.  
  51.   ?             reminder for available commands
  52.   ! [COMMAND]   shell escape for processing COMMAND
  53.   abort         get out of the current command right away
  54. ";
  55.  
  56. $NORMAL_HELP = "Usage: $PROGRAM [COMMANDS...]
  57.  
  58.   ! [COMMAND]   shell escape for processing COMMAND (defaults to shell)
  59.   abort         get out of the current command right away
  60.   quit          get out of program, saving file \`$CONFIG\' if modified
  61.  
  62. Synchronizing commands:
  63.   chdir [DIRECTORY]     change current directory to DIRECTORY
  64.   mode [MODE]           init (do not send contents) or noop (send nothing)
  65.   broadcast [SET]       export a synchronization package to each site of SET
  66.   process [FILE]        import a FILE (defaults to \`$ARCHIVE\')
  67.   process [DIRECTORY]   or use an already exploded DIRECTORY (\`$WORKDIR\')
  68.  
  69. Maintenance commands:
  70.   list                           list title, here, remotes, scans and ignores
  71.   files                          list all files and their known signatures
  72.   title [DESCRIPTION]            use DESCRIPTION as project title (or list it)
  73.   here [ADDRESS [DIRECTORY]]     declare our ADDRESS, modify visited DIRECTORY
  74.   remote [ADDRESS [DIRECTORY]]   declare remote ADDRESS, modify its DIRECTORY
  75.   scan [PATTERN]                 scan directory with \`find\' for shell PATTERN
  76.   ignore [REGEXP]                ignore scanned files if name matched by REGEXP
  77.   delete TYPE DATA               delete the remote, scan or ignore having DATA
  78.  
  79. To obtain partial lists, use appropriate commands without their parameters.
  80. Commands and keyword arguments may be abbreviated to one letter.
  81. ";
  82.  
  83. ## Programming notes around probable Perl 4.X bugs:
  84. ## * local($_) is avoided, so beware $_ may be destroyed by any routine.
  85. ## * @_ is always saved on each routine entry, where sub-routines are used.
  86.  
  87. while (@ARGV)
  88. {
  89.     if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver"
  90.     || $ARGV[0] eq "--vers" || $ARGV[0] eq "--versi"
  91.     || $ARGV[0] eq "--versio" || $ARGV[0] eq "--version")
  92.     {
  93.     print "$PROGRAM (format $FORMAT) - GNU $PACKAGE $VERSION\n";
  94.     exit 0;
  95.     }
  96.     elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel"
  97.        || $ARGV[0] eq "--help")
  98.     {
  99.     print $NORMAL_HELP;
  100.     exit 0;
  101.     }
  102.     else
  103.     {
  104.     last;
  105.     }
  106. }
  107.  
  108. if (@ARGV)
  109. {
  110.     $commands_ahead = join (";", @ARGV);
  111.     @ARGV = ();
  112. }
  113. else
  114. {
  115.     print STDERR $INITIAL_HELP;
  116. }
  117.  
  118. $fetch_config = 1;
  119.  
  120. &command_loop;
  121.  
  122. &maybe_save_config;
  123.  
  124. exit 0;
  125.  
  126. # Interactive command decoding.
  127.  
  128. ## Read user commands and dispatch them.
  129.  
  130. sub command_loop
  131. {
  132.     $command_loop = 1;
  133.  
  134.   COMMAND_LOOP:
  135.     while (1)
  136.     {
  137.     if ($commands_ahead)
  138.     {
  139.         if ($commands_ahead =~ /^([^;]*);(.*)/)
  140.         {
  141.         $_ = $1;
  142.         $commands_ahead = $2;
  143.         }
  144.         else
  145.         {
  146.         $_ = $commands_ahead;
  147.         $commands_ahead = "quit";
  148.         }
  149.     }
  150.     else
  151.     {
  152.         if ($noop_mode)
  153.         {
  154.         &query ("\nnoop>>");
  155.         }
  156.         elsif ($init_mode)
  157.         {
  158.         &query ("\ninit>>");
  159.         }
  160.         else
  161.         {
  162.         &query ("\n>>");
  163.         }
  164.     }
  165.     s/^ +//;
  166.     s/ +$//;
  167.  
  168.     next if /^$/;
  169.     next if /^#/;
  170.     last if /^q(uit)?$/;
  171.  
  172.     if (/^c(hdir)?$/ || /^pwd$/)
  173.     {
  174.         &command_list_cwd;
  175.     }
  176.     elsif (/^c(hdir|d)? +(.+)/)
  177.     {
  178.         &command_set_cwd ($2);
  179.     }
  180.     elsif (/^m(ode)?$/)
  181.     {
  182.         &command_list_mode;
  183.     }
  184.     elsif (/^m(ode)? +([^ ]+)$/)
  185.     {
  186.         &command_set_mode ($2);
  187.     }
  188.     elsif (/^b(roadcast)?$/)
  189.     {
  190.         &command_broadcast ("");
  191.     }
  192.     elsif (/^b(roadcast)? +(.+)$/)
  193.     {
  194.         &command_broadcast ($2);
  195.     }
  196.     elsif (/^p(rocess)?$/)
  197.     {
  198.         &command_process ("");
  199.     }
  200.     elsif (/^p(rocess)? +([^ ]+)$/)
  201.     {
  202.         &command_process ($2);
  203.     }
  204.     elsif (/^l(ist)?$/)
  205.     {
  206.         &command_list_almost_all;
  207.     }
  208.     elsif (/^f(iles)?$/)
  209.     {
  210.         &command_list_files;
  211.     }
  212.     elsif (/^t(itle)?$/)
  213.     {
  214.         &command_list_title;
  215.     }
  216.     elsif (/^t(itle)? +(.+)$/)
  217.     {
  218.         &command_set_title ($2);
  219.     }
  220.     elsif (/^h(ere)?$/)
  221.     {
  222.         &command_list_here;
  223.     }
  224.     elsif (/^h(ere)? +([^ ]+) *([^ ]*)$/)
  225.     {
  226.         &command_set_here ($2, $3);
  227.     }
  228.     elsif (/^r(emote)?$/)
  229.     {
  230.         &command_list_remote;
  231.     }
  232.     elsif (/^r(emote)? +([^ ]+) *([^ ]*)$/)
  233.     {
  234.         &command_set_remote ($2, $3);
  235.     }
  236.     elsif (/^s(can)?$/)
  237.     {
  238.         &command_list_scan;
  239.     }
  240.     elsif (/^s(can)? +([^ ]+)$/)
  241.     {
  242.         &command_set_scan ($2);
  243.     }
  244.     elsif (/^i(gnore)?$/)
  245.     {
  246.         &command_list_ignore;
  247.     }
  248.     elsif (/^i(gnore)? +([^ ]+)$/)
  249.     {
  250.         &command_set_ignore ($2);
  251.     }
  252.     elsif (/^d(elete)? *r(emote)? +([^ ]+)$/)
  253.     {
  254.         &command_delete_remote ($3);
  255.     }
  256.     elsif (/^d(elete)? *s(can)? +([^ ]+)$/)
  257.     {
  258.         &command_delete_scan ($3);
  259.     }
  260.     elsif (/^d(elete)? *i(gnore)? +([^ ]+)$/)
  261.     {
  262.         &command_delete_ignore ($3);
  263.     }
  264.     else
  265.     {
  266.         &diagnose ("Unrecognized command \`$_\', try \`?\' for help");
  267.     }
  268.     }
  269.  
  270.     $command_loop = 0;
  271. }
  272.  
  273. ## List current working directory.
  274. ## Synopses: `chdir' or `pwd'.
  275.  
  276. sub command_list_cwd
  277. {
  278.     print `pwd`;
  279. }
  280.  
  281. ## Change current working directory.
  282. ## Synopses: `chdir DIRECTORY' or `cd DIRECTORY'.
  283.  
  284. sub command_set_cwd
  285. {
  286.     local ($directory) = @_;
  287.  
  288.     $directory = &expand_filename ($directory);
  289.  
  290.     if (-d $directory)
  291.     {
  292.     &maybe_save_config;
  293.  
  294.     if (chdir ($directory))
  295.     {
  296.         $fetch_config = 1;
  297.     }
  298.     else
  299.     {
  300.         &diagnose ("Unable to change to directory \`$directory\'");
  301.     }
  302.     }
  303.     else
  304.     {
  305.     &diagnose ("Non-existing directory \`$directory\'");
  306.     }
  307. }
  308.  
  309. ## List all modes.
  310. ## Synopsis: `mode'.
  311.  
  312. sub command_list_mode
  313. {
  314.     print STDERR "\n";
  315.     printf STDERR
  316.     "Init mode %-5s   Send file signatures, but no file contents\n",
  317.     ($init_mode ? "(on)" : "(off)");
  318.     printf STDERR
  319.     "Noop mode %-5s   Avoid sending email, do not update \`$CONFIG\'",
  320.     ($noop_mode ? "(on)" : "(off)");
  321.     print STDERR "\n";
  322. }
  323.  
  324. ## Set one of modes.
  325. ## Synopsis: `mode MODE'.
  326.  
  327. sub command_set_mode
  328. {
  329.     local ($mode) = @_;
  330.  
  331.     if ($mode eq "i" || $mode eq "init")
  332.     {
  333.     $init_mode = 1;
  334.     }
  335.     elsif ($mode eq "n" || $mode eq "noop")
  336.     {
  337.     $noop_mode = 1;
  338.     }
  339.     else
  340.     {
  341.     &diagnose ("Unrecognized mode \`$mode\'");
  342.     }
  343. }
  344.  
  345. ## List title, here information, all remotes, all scans and all ignores.
  346. ## Synopsis: `list'.
  347.  
  348. sub command_list_almost_all
  349. {
  350.     &maybe_fetch_config;
  351.  
  352.     print "\n$project_title\n\n";
  353.  
  354.     print "HERE:\n";
  355.     &command_list_here;
  356.  
  357.     print "REMOTE:\n" if @remote;
  358.     &command_list_remote;
  359.  
  360.     print "SCAN:\n" if %scan;
  361.     &command_list_scan;
  362.  
  363.     print "IGNORE:\n" if %ignore;
  364.     &command_list_ignore;
  365. }
  366.  
  367. ## List information for all files.
  368. ## Synopsis: `files'.
  369.  
  370. sub command_list_files
  371. {
  372.     local ($format, $field);
  373.  
  374.     &maybe_fetch_config;
  375.     &maybe_study_files;
  376.  
  377.     $format = "  %-5s  %-${maximum_name_width}s  ";
  378.     foreach (sort keys %signature)
  379.     {
  380.     printf $format, $here_signature{$_}, $_;
  381.     foreach $field (split (/ /, $signature{$_}))
  382.     {
  383.         $field = " ..." if $field eq $here_signature{$_};
  384.         printf "%-7s", $field;
  385.     }
  386.     print "\n";
  387.     }
  388. }
  389.  
  390. ## List the title of the project.
  391. ## Synopsis: `title'.
  392.  
  393. sub command_list_title
  394. {
  395.     &maybe_fetch_config;
  396.  
  397.     print "$project_title\n";
  398. }
  399.  
  400. ## Set the title of the project.
  401. ## Synopsis: `title DESCRIPTION'.
  402.  
  403. sub command_set_title
  404. {
  405.     local ($description) = @_;
  406.  
  407.     &maybe_fetch_config;
  408.  
  409.     if ($description ne $project_title)
  410.     {
  411.     $project_title = $description;
  412.     $save_config = 1;
  413.     }
  414. }
  415.  
  416. ## List local information.
  417. ## Synopsis: `here'.
  418.  
  419. sub command_list_here
  420. {
  421.     &maybe_fetch_config;
  422.  
  423.     print "  [0]\t$here_email $here_home\n";
  424. }
  425.  
  426. ## Modify our local information to ADDRESS and DIRECTORY.
  427. ## Synopsis: `here ADDRESS DIRECTORY'.
  428.  
  429. sub command_set_here
  430. {
  431.     local ($email, $directory) = @_;
  432.  
  433.     &maybe_fetch_config;
  434.  
  435.     $email =~ tr/A-Z/a-z/;
  436.     if ($email ne "-" && $email ne $here_email)
  437.     {
  438.     $here_email = $email;
  439.     $save_config = 1;
  440.     }
  441.  
  442.     if ($directory && $directory ne $here_home)
  443.     {
  444.     $here_home = &normalize_directory ($directory);
  445.     $config_filename = &expand_filename ("$here_home/$CONFIG");
  446.     $save_config = 1;
  447.     }
  448. }
  449.  
  450. ## List information for all remotes.
  451. ## Synopsis: `remote'.
  452.  
  453. sub command_list_remote
  454. {
  455.     local ($index, $email);
  456.  
  457.     &maybe_fetch_config;
  458.  
  459.     $index = 0;
  460.     foreach (@remote)
  461.     {
  462.     $index++;
  463.     print "  [$index]\t$_ $remote{$_}\n";
  464.     }
  465. }
  466.  
  467. ## Create a new remote given its REMOTE address, modify its DIRECTORY.
  468. ## Synopsis: `remote REMOTE DIRECTORY'.
  469.  
  470. sub command_set_remote
  471. {
  472.     local ($remote, $directory) = @_;
  473.     local ($index);
  474.  
  475.     &maybe_fetch_config;
  476.  
  477.     $remote =~ tr/A-Z/a-z/;
  478.     $remote = @remote[$remote - 1] if ($remote > 0 && $remote <= @remote);
  479.  
  480.     if (defined $remote{$remote})
  481.     {
  482.     if ($directory && $remote{$remote} ne $directory)
  483.     {
  484.         $remote{$remote} = $directory;
  485.         $save_config = 1;
  486.     }
  487.     elsif ($remote{$remote} ne "-")
  488.     {
  489.         &diagnose ("Remote directory is known to be \`$remote{$remote}\'");
  490.         &query ("Do you want me to keep this knowledge (y/n)? [y]");
  491.         if (! /(y|yes)/i)
  492.         {
  493.         $remote{$remote} = "-";
  494.         $save_config = 1;
  495.         }
  496.     }
  497.     }
  498.     else
  499.     {
  500.     if ($directory)
  501.     {
  502.         &create_remote ($remote, $directory);
  503.     }
  504.     else
  505.     {
  506.         &create_remote ($remote, "-");
  507.         $index = @remote;
  508.         &warn ("You may also use \`remote $index DIRECTORY\'"
  509.            . " if you know the remote directory");
  510.     }
  511.     }
  512. }
  513.  
  514. ## Delete an existing remote given its ADDRESS address.
  515. ## Synopsis: `delete remote ADDRESS'.
  516.  
  517. sub command_delete_remote
  518. {
  519.     local ($remote) = @_;
  520.  
  521.     &maybe_fetch_config;
  522.  
  523.     $remote = @remote[$remote - 1] if ($remote > 0 && $remote <= @remote);
  524.     &delete_remote ($remote);
  525. }
  526.  
  527. ## List information for all scans.
  528. ## Synopsis: `scan'.
  529.  
  530. sub command_list_scan
  531. {
  532.     local ($index);
  533.  
  534.     &maybe_fetch_config;
  535.  
  536.     $index = 0;
  537.     @scan = ();
  538.     foreach (sort keys %scan)
  539.     {
  540.     $index++;
  541.     push (@scan, $_);
  542.     print "  [$index]\t$_\n";
  543.     }
  544. }
  545.  
  546. ## Create a new SCAN.
  547. ## Synopsis: `scan SCAN'.
  548.  
  549. sub command_set_scan
  550. {
  551.     local ($scan) = @_;
  552.  
  553.     &maybe_fetch_config;
  554.  
  555.     if (defined $scan{$scan})
  556.     {
  557.     &diagnose ("Redundant creation of scan \`$scan\'");
  558.     }
  559.     else
  560.     {
  561.     $scan{$scan} = 1;
  562.     $save_config = 1;
  563.     $study_files = 1;
  564.     }
  565. }
  566.  
  567. ## Delete an existing SCAN.
  568. ## Synopsis: `delete scan SCAN'.
  569.  
  570. sub command_delete_scan
  571. {
  572.     local ($scan) = @_;
  573.  
  574.     &maybe_fetch_config;
  575.  
  576.     $scan = @scan[$scan - 1] if ($scan > 0 && $scan <= @scan);
  577.     if (defined $scan{$scan})
  578.     {
  579.     delete $scan{$scan};
  580.     $save_config = 1;
  581.     $study_files = 1;
  582.     }
  583.     else
  584.     {
  585.     &diagnose ("Cannot delete inexisting scan \`$scan\'");
  586.     }
  587. }
  588.  
  589. ## List information for all ignores.
  590. ## Synopsis: `ignore'.
  591.  
  592. sub command_list_ignore
  593. {
  594.     local ($index);
  595.  
  596.     &maybe_fetch_config;
  597.  
  598.     $index = 0;
  599.     @ignore = ();
  600.     foreach (sort keys %ignore)
  601.     {
  602.     $index++;
  603.     push (@ignore, $_);
  604.     print "  [$index]\t$_\n";
  605.     }
  606. }
  607.  
  608. ## Create a new IGNORE.
  609. ## Synopsis: `ignore IGNORE'.
  610.  
  611. sub command_set_ignore
  612. {
  613.     local ($ignore) = @_;
  614.  
  615.     &maybe_fetch_config;
  616.  
  617.     if (defined $ignore{$ignore})
  618.     {
  619.     &diagnose ("Redundant creation of ignore \`$ignore\'");
  620.     }
  621.     else
  622.     {
  623.     $ignore{$ignore} = 1;
  624.     $save_config = 1;
  625.     $study_files = 1;
  626.     }
  627. }
  628.  
  629. ## Delete an existing IGNORE.
  630. ## Synopsis: `delete ignore IGNORE'.
  631.  
  632. sub command_delete_ignore
  633. {
  634.     local ($ignore) = @_;
  635.     local ($index);
  636.  
  637.     &maybe_fetch_config;
  638.  
  639.     $ignore = @ignore[$ignore - 1] if ($ignore > 0 && $ignore <= @ignore);
  640.     if (defined $ignore{$ignore})
  641.     {
  642.     delete $ignore{$ignore};
  643.     $save_config = 1;
  644.     $study_files = 1;
  645.     }
  646.     else
  647.     {
  648.     &diagnose ("Cannot delete inexisting ignore \`$ignore\'");
  649.     }
  650. }
  651.  
  652. # Broadcasting away synchronization packages.
  653.  
  654. ## Export a synchronization package to each site of SET.
  655. ## Synopsis: `broadcast SET'.
  656.  
  657. sub command_broadcast
  658. {
  659.     local ($set) = @_;
  660.     local ($site, $index, $ordinal, $file, @signature);
  661.  
  662.     &maybe_fetch_config;
  663.  
  664.     &decode_site_set ($set);
  665.     foreach $site (@site_set)
  666.     {
  667.     &warn ("");
  668.     &warn ("Broadcasting to address \`$remote[$site]\'");
  669.  
  670.     if (-f $ARCHIVE && ! $noop_mode)
  671.     {
  672.         &diagnose ("The archive \`$ARCHIVE\' already exists!");
  673.         &query ("Should I delete it for you (y/n)? [n]");
  674.         &interrupt ("Command aborted!") if ! /^(y|yes)/i;
  675.         unlink $ARCHIVE
  676.         || &interrupt ("Cannot delete file \`$ARCHIVE\'");
  677.     }
  678.     if (-d $WORKDIR && ! $noop_mode)
  679.     {
  680.         &diagnose ("The work directory \`$WORKDIR\' already exists!");
  681.         &query ("Should I remove all of it first (y/n)? [y]");
  682.         &interrupt ("Command aborted!") if ! /^(y|yes)/i;
  683.         system "rm -rf $WORKDIR"
  684.         || &interrupt ("Cannot remove directory \`$WORKDIR\'");
  685.     }
  686.  
  687.     &maybe_study_files;
  688.     &update_file_registry;
  689.  
  690.     # Initialize the invoice.
  691.  
  692.     if (! $noop_mode)
  693.     {
  694.         mkdir ($WORKDIR, 0700)
  695.         || &interrupt ("Unable to make directory \`$WORKDIR\'");
  696.         open (OUTPUT, ">$WORKDIR/$ORDERS")
  697.         || &interrupt ("Cannot create file \`$WORKDIR/$ORDERS\'");
  698.  
  699.         print OUTPUT "format\t$PROGRAM $FORMAT\n";
  700.         print OUTPUT "title\t$project_title\n";
  701.         print OUTPUT "here\t$here_email $here_home\n";
  702.         foreach (@remote)
  703.         {
  704.         print OUTPUT "remote\t$_ $remote{$_}\n";
  705.         }
  706.         foreach (sort keys %scan)
  707.         {
  708.         print OUTPUT "scan\t$_\n";
  709.         }
  710.         foreach (sort keys %ignore)
  711.         {
  712.         print OUTPUT "ignore\t$_\n";
  713.         }
  714.  
  715.         print OUTPUT "visit\t$site\n";
  716.         print OUTPUT "copy\t", join (" ", @site_set), "\n";
  717.     }
  718.  
  719.     # Transmit all file signatures and replacement orders.
  720.  
  721.     $ordinal = 0;
  722.     foreach $file (sort keys %signature)
  723.     {
  724.         if (! $noop_mode)
  725.         {
  726.         print OUTPUT "check\t$file $here_signature{$file}";
  727.         @signature = split (/ /, $signature{$file});
  728.         foreach (@site_set)
  729.         {
  730.             print OUTPUT " ", $signature[$_];
  731.         }
  732.         print OUTPUT "\n";
  733.         }
  734.  
  735.         next if $init_mode;
  736.         next if $signature[$site] eq $here_signature{$file};
  737.  
  738.         &warn ("Packaging file \`$file\'");
  739.         if (! $noop_mode)
  740.         {
  741.         $ordinal++;
  742.         symlink ("../$file", "$WORKDIR/$ordinal");
  743.         print OUTPUT "update\t$file $signature[$site] $ordinal\n";
  744.         }
  745.         $signature[$site] = $here_signature{$file};
  746.         $signature{$file} = join (" ", @signature);
  747.         $save_config = 1;
  748.     }
  749.  
  750.     # Complete the invoice.
  751.  
  752.     if (! $noop_mode)
  753.     {
  754.         close OUTPUT;
  755.         system "$TAR cfzh $ARCHIVE $WORKDIR"
  756.         || &interrupt ("Cannot construct archive \`$ARCHIVE\'"
  757.                    . " from directory \`$WORKDIR\'");
  758.         system "rm -rf $WORKDIR"
  759.         || &interrupt ("Cannot remove directory \`$WORKDIR\'");
  760.         system "mailshar $remote[$site] $ARCHIVE"
  761.         || &interrupt ("Cannot send file \`$ARCHIVE\'"
  762.                    . " to address \`$remote[$site]\'");
  763.         unlink $ARCHIVE
  764.         || &interrupt ("Cannot delete file \`$ARCHIVE\'");
  765.     }
  766.     }
  767.     &warn ("Command \`broadcast\' done");
  768. }
  769.  
  770. # Processing received synchronization packages.
  771.  
  772. ## Import a FILE or use an already exploded DIRECTORY.
  773. ## Synopses: `process [FILE]' or `process [DIRECTORY]'.
  774.  
  775. sub command_process
  776. {
  777.     local ($argument) = @_;
  778.     local ($archive, $prior, $file, @signature);
  779.  
  780.     $work_directory = &expand_filename ($WORKDIR);
  781.  
  782.     if ($argument)
  783.     {
  784.     $archive = &expand_filename ($argument);
  785.     }
  786.     elsif (-f $ARCHIVE)
  787.     {
  788.     $archive = &expand_filename ($ARCHIVE);
  789.     $archive_to_unlink = $archive if ! $noop_mode;
  790.     }
  791.     elsif (-d $WORKDIR)
  792.     {
  793.     $archive = $work_directory;
  794.     }
  795.     else
  796.     {
  797.     &interrupt ("No argument, no archive \`$ARCHIVE\'"
  798.             . " and no directory \`$WORKDIR\'");
  799.     }
  800.  
  801.     if (-f $archive)
  802.     {
  803.     &warn ("Exploding archive \`$archive\'");
  804.  
  805.     if (-d $WORKDIR)
  806.     {
  807.         &diagnose ("The work directory \`$WORKDIR\' already exists!");
  808.         &query ("Should I remove all of it first (y/n)? [y]");
  809.         &interrupt ("Command aborted!") if ! /^(y|yes)/i;
  810.         system "rm -rf $WORKDIR"
  811.         || &interrupt ("Cannot remove directory \`$WORKDIR\'");
  812.     }
  813.  
  814.     system "$TAR xfoz $archive"
  815.         || &interrupt ("Failure while untarring file \`$archive\'");
  816.     $workdir_to_unlink = $work_directory;
  817.     }
  818.  
  819.     chop ($prior = `pwd`);
  820.     open (PACKAGE, "$work_directory/$ORDERS")
  821.     || &interrupt ("Cannot read file \`$work_directory/$ORDERS\'");
  822.  
  823.     &process_loop;
  824.  
  825.     close PACKAGE;
  826.     chdir $prior;
  827.  
  828.     if ($workdir_to_unlink)
  829.     {
  830.     unlink "$workdir_to_unlink/$ORDERS"
  831.         || &diagnose ("Cannot delete file \`$workdir_to_unlink/$ORDERS\'");
  832.     rmdir $workdir_to_unlink
  833.         || &diagnose ("Cannot remove directory \`$workdir_to_unlink\'");
  834.     $workdir_to_unlink = "";
  835.     }
  836.  
  837.     if ($archive_to_unlink)
  838.     {
  839.     unlink $archive_to_unlink
  840.         || &diagnose ("Cannot delete file \`$archive_to_unlink\'");
  841.     $archive_to_unlink = "";
  842.     }
  843.     &warn ("Command \`process\' done");
  844. }
  845.  
  846. ## Decode each received package orders, in turn.  Most validation
  847. ## is delayed until the \`visit\' order.
  848.  
  849. sub process_loop
  850. {
  851.     $process_loop = 1;
  852.  
  853.   PROCESS_LOOP:
  854.     while (<PACKAGE>)
  855.     {
  856.     chop;
  857.  
  858.     # Handle commands not requiring the analysis of file $CONFIG.
  859.  
  860.     if (/^(format|version)\t$PROGRAM ([^ ]+)$/o)
  861.     {
  862.         &interrupt
  863.         ("Need $PROGRAM (format $FORMAT) to process this package!")
  864.             if $2 ne $FORMAT;
  865.     }
  866.     elsif (/^title\t(.*)/)
  867.     {
  868.         $project_title_received = $1;
  869.     }
  870.     elsif (/^(here|local)\t([^ ]+) ([^ ]+)$/)
  871.     {
  872.         ($here_email_received, $here_home_received) = ($2, $3);
  873.         $here_email_received =~ tr/A-Z/a-z/;
  874.     }
  875.     elsif (/^remote\t([^ ]+) ([^ ]+)$/)
  876.     {
  877.         push (@remote_received, $1);
  878.         $remote_received{$1} = $2;
  879.         $remote_received =~ tr/A-Z/a-z/;
  880.     }
  881.     elsif (/^scan\t([^ ]+)$/)
  882.     {
  883.         $scan_received{$1} = 1;
  884.     }
  885.     elsif (/^ignore\t([^ ]+)$/)
  886.     {
  887.         $ignore_received{&convert_ignore ($1)} = 1;
  888.     }
  889.     elsif (/^visit\t([^ ]+)$/)
  890.     {
  891.         &process_visit ($1);
  892.     }
  893.     elsif (/^copy\t(.+)/)
  894.     {
  895.         &process_copy ($1);
  896.     }
  897.     elsif (/^check\t([^ ]+) ([^ ]+) (.+)/)
  898.     {
  899.         &process_check ($1, $2, $3);
  900.     }
  901.     elsif (/^update\t([^ ]+) ([^ ]+) ([^ ]+)$/)
  902.     {
  903.         &process_update ($1, $2, $3);
  904.     }
  905.     else
  906.     {
  907.         &interrupt ("Unrecognized command \`$_\' in process input");
  908.     }
  909.     }
  910.  
  911.     $process_loop = 0;
  912.     &update_file_registry;
  913.  
  914.     if (%signature_received)
  915.     {
  916.     foreach $file (sort keys %signature)
  917.     {
  918.         if (! defined $signature_received{$file})
  919.         {
  920.         &diagnose ("File \`$file\' is not registered remotely");
  921.  
  922.         @signature = split (/ /, $signature{$file});
  923.         if ($signature[$from_email] ne "-")
  924.         {
  925.             $signature[$from_email] = "-";
  926.             $save_config = 1;
  927.             $signature{$file} = join (" ", @signature);
  928.         }
  929.  
  930.         &query ("Should I delete this file, here too (y/n)? [n]");
  931.         if (/^(y|yes)$/i)
  932.         {
  933.             if (! $noop_mode)
  934.             {
  935.             unlink $file
  936.                 || &diagnose ("Cannot delete file \`$file\'");
  937.             }
  938.             delete $signature{$file};
  939.         }
  940.         }
  941.     }
  942.     }
  943. }
  944.  
  945. ## Prepare to visit a directory, conciliating all received information.
  946. ## Synopsis: `visit VISITED', where VISITED is an index in remotes.
  947.  
  948. sub process_visit
  949. {
  950.     local ($visited) = @_;
  951.     local ($email, $home, $string, $scan, $ignore);
  952.  
  953.     &maybe_save_config;
  954.  
  955.     &warn ("");
  956.     &warn ("Package being received:");
  957.     &warn ("  from address \`$here_email_received\'");
  958.     &warn ("  for project \`$project_title_received\'");
  959.  
  960.     # Check the recipient address.
  961.  
  962.     $email = &guess_here_email;
  963.     $string = $remote_received[$visited];
  964.  
  965.     if (! &equivalent_email ($email, $string))
  966.     {
  967.     &diagnose ("This package was sent to address \`$string\'");
  968.     &warn ("but your address is known to be \`$email\'");
  969.     &warn ("");
  970.     &warn ("The possibilities at this point are:");
  971.     &warn ("  1. Correct your full email address to \`$string\'");
  972.     &warn ("  2. Use your current email address \`$email\'");
  973.     &warn ("  3. Specify another full email address (beware!)");
  974.     &warn ("  4. Abandon the processing of this package");
  975.     $_ = "";
  976.     &query ("Which action do you choose (1-4)? [1]")
  977.         while ! /^[1-4]$/;
  978.     if ($_ eq "1")
  979.     {
  980.         $email = $string;
  981.     }
  982.     elsif ($_ eq "3")
  983.     {
  984.         $_ = &guess_here_email;
  985.         &query ("What is your full email address, here? [$_]");
  986.         $email = $_;
  987.     }
  988.     elsif ($_ eq "4")
  989.     {
  990.         &interrupt ("Command aborted!");
  991.     }
  992.     }
  993.  
  994.     # Check the recipient directory.
  995.  
  996.     $string = $remote_received{$string};
  997.     $_ = &expand_filename ($string);
  998.     if (-d $_)
  999.     {
  1000.     $home = $string;
  1001.     }
  1002.     else
  1003.     {
  1004.     chop ($_ = `pwd`);
  1005.     $home = &normalize_directory ($_);
  1006.  
  1007.     &diagnose ("This package was aimed for directory \`$string\'");
  1008.     &warn ("but this directory does not exist here");
  1009.     &warn ("");
  1010.     &warn ("The possibilities at this point are:");
  1011.     &warn ("  1. Attempt creating the \`$string\' directory");
  1012.     &warn ("  2. Use the current directory \`$home\' (are you sure?)");
  1013.     &warn ("  3. Specify another synchronized directory (beware!)");
  1014.     &warn ("  4. Abandon the processing of this package");
  1015.     $_ = "";
  1016.     &query ("Which action do you choose (1-4)? [1]")
  1017.         while ! /^[1-4]$/;
  1018.     if ($_ eq "1")
  1019.     {
  1020.         $home = $string;
  1021.     }
  1022.     elsif ($_ eq "3")
  1023.     {
  1024.         &query ("Which directory should be used? [$home]");
  1025.         $home = &normalize_directory ($_);
  1026.     }
  1027.     elsif ($_ eq "4")
  1028.     {
  1029.         &interrupt ("Command aborted!");
  1030.     }
  1031.     }
  1032.  
  1033.     # Force our way to the wanted directory.
  1034.  
  1035.     &warn ("Visiting directory \`$home',"
  1036.        . " remote was \`$here_home_received\'");
  1037.  
  1038.     $home = &expand_filename ($home);
  1039.     &prepare_filename ("$home/$CONFIG");
  1040.     chdir $home || &interrupt ("Cannot change directory to \`$home\'");
  1041.  
  1042.     # Swallow or simulate the $CONFIG file.
  1043.  
  1044.     if (-f "$home/$CONFIG")
  1045.     {
  1046.     $fetch_config = 1;
  1047.     &maybe_fetch_config;
  1048.  
  1049.     # Reconciliate $project_title.
  1050.  
  1051.     if ($project_title ne $project_title_received)
  1052.     {
  1053.         &diagnose ("The package title is \`$project_title_received\'");
  1054.         &warn ("but \`$CONFIG\' says it should be \`$project_title\'");
  1055.         &warn ("");
  1056.         &warn ("The possibilities at this point are:");
  1057.         &warn ("  1. Use \`$project_title_received\' as title");
  1058.         &warn ("  2. Keep \`$project_title' as title\'");
  1059.         &warn ("  3. Specify another project title");
  1060.         $_ = "";
  1061.         &query ("Which action do you choose (1-3)? [1]")
  1062.         while ! /^[1-3]$/;
  1063.         if ($_ eq "1")
  1064.         {
  1065.         $project_title = $project_title_received;
  1066.         }
  1067.         elsif ($_ eq "3")
  1068.         {
  1069.         &query ("What will be the new project title?");
  1070.         $project_title = $_;
  1071.         }
  1072.     }
  1073.  
  1074.     # Reconciliate $here_email.
  1075.  
  1076.     if (! &equivalent_email ($email, $here_email))
  1077.     {
  1078.         &diagnose ("This package is sent to address \`$here_email\'");
  1079.         &warn ("but \`$CONFIG\' says it should have been \`$email\'");
  1080.         &warn ("");
  1081.         &warn ("The possibilities at this point are:");
  1082.         &warn ("  1. Use your current full email address \`$email\'");
  1083.         &warn ("  2. Correct your full email address to \`$here_email\'");
  1084.         &warn ("  3. Specify another full email address");
  1085.         $_ = "";
  1086.         &query ("Which action do you choose (1-3)? [1]")
  1087.         while ! /^[1-3]$/;
  1088.         if ($_ eq "1")
  1089.         {
  1090.         $here_email = $email;
  1091.         }
  1092.         elsif ($_ eq "3")
  1093.         {
  1094.         $_ = &guess_here_email;
  1095.         &query ("What is your full email address, here? [$_]");
  1096.         $here_email = $_;
  1097.         }
  1098.     }
  1099.  
  1100.     # Reconciliate $here_home.
  1101.  
  1102.     $home = &normalize_directory ($home);
  1103.     if ($home ne $here_home)
  1104.     {
  1105.         &diagnose ("This package is aimed for directory \`$here_home\'");
  1106.         &warn ("but \`$CONFIG\' says it should have been \`$home\'");
  1107.         &warn ("");
  1108.         &warn ("The possibilities at this point are:");
  1109.         &warn ("  1. Record the \`$home\' directory in the configuration");
  1110.         &warn ("  2. Correct the directory to \`$here_home\'");
  1111.         &warn ("  3. Record another name for this directory (beware!)");
  1112.         $_ = "";
  1113.         &query ("Which action do you choose (1-3)? [1]")
  1114.         while ! /^[1-3]$/;
  1115.         if ($_ eq "1")
  1116.         {
  1117.         $here_home = $home;
  1118.         $config_filename = &expand_filename ("$here_home/$CONFIG");
  1119.         }
  1120.         elsif ($_ eq "3")
  1121.         {
  1122.         &query ("Which directory should be used? [$home]");
  1123.         $here_home = &normalize_directory ($_);
  1124.         $config_filename = &expand_filename ("$here_home/$CONFIG");
  1125.         }
  1126.     }
  1127.  
  1128.     # Reconciliate remote information.
  1129.  
  1130.     foreach $remote (sort keys %remote)
  1131.     {
  1132.         if (defined $remote_received{$remote})
  1133.         {
  1134.         if ($remote{$remote} ne $remote_received{$remote})
  1135.         {
  1136.             &diagnose ("Conflicting directories for \`$remote\'");
  1137.             &warn ("registered as \`$remote{$remote}\' here and");
  1138.             &warn ("as \`$remote_received{$remote}\' remotely");
  1139.         }
  1140.         delete $remote_received{$remote};
  1141.         }
  1142.         elsif ($remote ne $here_email_received)
  1143.         {
  1144.         &diagnose ("Remote \`$remote\' is not registered remotely");
  1145.         &query ("Should I unregister it here (y/n)? [n]");
  1146.         delete $remote{$remote} if /(y|yes)/i;
  1147.         }
  1148.     }
  1149.     foreach $remote (sort keys %remote_received)
  1150.     {
  1151.         if ($remote ne $here_email)
  1152.         {
  1153.         &diagnose ("Remote \`$remote\' is registered remotely"
  1154.                . " and not locally");
  1155.         &query ("Should I register it here (y/n)? [y]");
  1156.         &create_remote ($remote, $remote_received{$remote})
  1157.             if (/(y|yes)/i);
  1158.         }
  1159.         delete $remote_received{$remote};
  1160.     }
  1161.  
  1162.     # Reconciliate scan information.
  1163.  
  1164.     foreach $scan (sort keys %scan)
  1165.     {
  1166.         if (defined $scan_received{$scan})
  1167.         {
  1168.         delete $scan_received{$scan};
  1169.         }
  1170.         else
  1171.         {
  1172.         &diagnose ("Scan \`$scan\' is not registered remotely");
  1173.         &query ("Should I unregister it here (y/n)? [n]");
  1174.         delete $scan{$scan} if /(y|yes)/i;
  1175.         }
  1176.     }
  1177.     foreach $scan (sort keys %scan_received)
  1178.     {
  1179.         &diagnose
  1180.         ("Scan \`$scan\' is registered remotely and not locally");
  1181.         &query ("Should I register it here (y/n)? [y]");
  1182.         $scan{$scan} = $NEWLY_CREATED_SCAN if /(y|yes)/i;
  1183.         delete $scan_received{$scan};
  1184.     }
  1185.  
  1186.     # Reconciliate ignore information.
  1187.  
  1188.     foreach $ignore (sort keys %ignore)
  1189.     {
  1190.         if (defined $ignore_received{$ignore})
  1191.         {
  1192.         delete $ignore_received{$ignore};
  1193.         }
  1194.         else
  1195.         {
  1196.         &diagnose ("Ignore \`$ignore\' is not registered remotely");
  1197.         &query ("Should I unregister it here (y/n)? [n]");
  1198.         delete $ignore{$ignore} if /(y|yes)/i;
  1199.         }
  1200.     }
  1201.     foreach $ignore (sort keys %ignore_received)
  1202.     {
  1203.         &diagnose
  1204.         ("Ignore \`$ignore\' is registered remotely and not locally");
  1205.         &query ("Should I register it here (y/n)? [y]");
  1206.         $ignore{$ignore} = 1 if /(y|yes)/i;
  1207.         delete $ignore_received{$ignore};
  1208.     }
  1209.     }
  1210.     else
  1211.     {
  1212.  
  1213.     # Use remote information for initializing the local one.
  1214.  
  1215.     &warn ("Initializing file \`$CONFIG\' from received information");
  1216.  
  1217.     $project_title = $project_title_received;
  1218.     $here_email = $remote_received[$visited];
  1219.     $here_home = $remote_received{$here_email};
  1220.     $config_filename = &expand_filename ("$here_home/$CONFIG");
  1221.  
  1222.     if ($here_email ne $here_email_received)
  1223.     {
  1224.         $remote_received[$visited] = $here_email_received;
  1225.         $remote_received{$here_email_received} = $here_home_received;
  1226.         delete $remote_received{$here_email};
  1227.     }
  1228.  
  1229.     @remote = @remote_received;
  1230.  
  1231.     %remote = %remote_received;
  1232.     %remote_received = ();
  1233.     %scan = %scan_received;
  1234.     %scan_received = ();
  1235.     %ignore = %ignore_received;
  1236.     %ignore_received = ();
  1237.  
  1238.     $new_config = 1;
  1239.     $save_config = 1;
  1240.     $fetch_config = 0;
  1241.     $study_files = 1;
  1242.     }
  1243. }
  1244.  
  1245. ## Package was sent to each address in SET.
  1246. ## Synopsis: `copy SET'.
  1247.  
  1248. sub process_copy
  1249. {
  1250.     local ($set) = @_;
  1251.     local ($index);
  1252.  
  1253.     &maybe_fetch_config;
  1254.  
  1255.     @copy_list = ();
  1256.     $counter = 0;
  1257.     foreach (split (" ", $set))
  1258.     {
  1259.     $_ = $remote_received[$_];
  1260.  
  1261.     $copy_list[$counter++]
  1262.         = $_ eq $here_email ? -1 : &validated_remote_index ($_);
  1263.     }
  1264. }
  1265.  
  1266. ## Set FILE signatures to SIGNATURE, given a SET of previous values.
  1267. ## Synopsis: `check FILE SIGNATURE SET'.
  1268.  
  1269. sub process_check
  1270. {
  1271.     local ($file, $signature, $set) = @_;
  1272.     local (@signature, @check, $counter, $new_signature);
  1273.  
  1274.     @check = split (" ", $set);
  1275.     &interrupt ("Unmatching number of signatures for file \`$file\'")
  1276.     if @check != @copy_list;
  1277.  
  1278. #   &maybe_fetch_config;
  1279.     &maybe_study_files;
  1280.  
  1281.     if (defined $signature{$file})
  1282.     {
  1283.     @signature = split (/ /, $signature{$file});
  1284.     }
  1285.     else
  1286.     {
  1287.     @signature = ("-") x @remote;
  1288.     }
  1289.     if ($signature ne $signature[$from_email])
  1290.     {
  1291.     $signature[$from_email] = $signature;
  1292.     $save_config = 1;
  1293.     }
  1294.     for ($counter = 0; $counter < @check; $counter++)
  1295.     {
  1296.     if ($copy_list[$counter] >= 0 && $check[$counter] ne "-")
  1297.     {
  1298.         if ($signature[$copy_list[$counter]] eq "-"
  1299.         || $signature[$copy_list[$counter]] eq $check[$counter])
  1300.         {
  1301.         $new_signature = $signature;
  1302.         }
  1303.         else
  1304.         {
  1305.  
  1306.         # If we do have an idea of a remote file\'s signature, and
  1307.         # if this idea is contradicted by a synchronization
  1308.         # package, rather say we know nothing besides that the
  1309.         # file merely exists.  Give it a signature from hell.
  1310.  
  1311.         $new_signature = "666";
  1312.         }
  1313.         if ($new_signature ne $signature[$copy_list[$counter]])
  1314.         {
  1315.         $signature[$copy_list[$counter]] = $new_signature;
  1316.         $save_config = 1;
  1317.         }
  1318.     }
  1319.     }
  1320.  
  1321.     $signature{$file} = join (" ", @signature);
  1322.     $signature_received{$file} = 1;
  1323. }
  1324.  
  1325. ## If FILE checks to SIGNATURE, replace it by PACKAGED.
  1326. ## Synopsis: `update FILE SIGNATURE PACKAGED'.
  1327.  
  1328. sub process_update
  1329. {
  1330.     local ($file, $old_signature, $packaged) = @_;
  1331.     local ($action, $cautious, $packaged_signature);
  1332.  
  1333.     $packaged = "$work_directory/$packaged";
  1334.  
  1335. #   &maybe_fetch_config;
  1336. #   &maybe_study_files;
  1337.  
  1338.     if (&ignorable_file ($file))
  1339.     {
  1340.     &diagnose ("File \`$file\' is the subject of some \`ignore\'");
  1341.     &query ("Should I accept it nevertheless (y/n)? [n]");
  1342.     $action = "UNLINK" if ! /^(y|yes)$/i;
  1343.     }
  1344.  
  1345.     if (! $action && -f $file && ! defined $here_signature{$file})
  1346.     {
  1347.     &diagnose ("File \`$file\' was not locally scanned");
  1348.     $here_signature{$file} = &single_signature ($file);
  1349.     $cautious = 1;
  1350.     }
  1351.  
  1352.     if (! $action && -f $file && $old_signature eq $here_signature{$file})
  1353.     {
  1354.     if ($cautious)
  1355.     {
  1356.         &query ("Show diffs before updating it (y/n)? [y]");
  1357.         $action = /^(y|yes)$/i ? "DIFF" : "MOVE";
  1358.     }
  1359.     else
  1360.     {
  1361.         &warn ("Updating file \`$file\'");
  1362.         $action = "MOVE";
  1363.     }
  1364.     }
  1365.  
  1366.     if (! $action && -f $file)
  1367.     {
  1368.     $packaged_signature = &single_signature ($packaged);
  1369.     if ($old_signature eq "-")
  1370.     {
  1371.         if ($packaged_signature eq $here_signature{$file})
  1372.         {
  1373.         &diagnose ("Redundant creation of file \`$file\'");
  1374.         $action = "UNLINK";
  1375.         }
  1376.         else
  1377.         {
  1378.         &diagnose ("Unexpected preexisting file \`$file'");
  1379.         $action = "DIFF";
  1380.         }
  1381.     }
  1382.     else
  1383.     {
  1384.         if ($packaged_signature eq $here_signature{$file})
  1385.         {
  1386.         &diagnose ("Redundant updating of file \`$file\'");
  1387.         $action = "UNLINK";
  1388.         }
  1389.         else
  1390.         {
  1391.         &diagnose ("Local changes occurred to file \`$file\'");
  1392.         $action = "DIFF";
  1393.         }
  1394.     }
  1395.     }
  1396.  
  1397.     if (! $action)        # $file does not exist locally
  1398.     {
  1399.     if ($old_signature eq "-")
  1400.     {
  1401.         &warn ("Creating new file \`$file\'");
  1402.         $action = "MOVE";
  1403.     }
  1404.     else
  1405.     {
  1406.         &diagnose ("File \`$file\' has locally disappeared");
  1407.         &query ("Should I recreate it from remote copy (y/n)? [y]");
  1408.         $action = /^(y|yes)$/i ? "MOVE" : "UNLINK";
  1409.     }
  1410.     }
  1411.  
  1412.     if ($action eq "DIFF")
  1413.     {
  1414.     &warn ("");
  1415.     &warn ("$DIFF -u $file $packaged");
  1416.     system "$DIFF -u $file $packaged";
  1417.     &warn ("");
  1418.     &warn ("Before replying to next question, please reconciliate:");
  1419.     &warn ("  -) \`$file\'");
  1420.     &warn ("  +) \`$packaged\'");
  1421.     &warn ("");
  1422.     &query ("Now, which of these files should be kept (-/+)? [-]");
  1423.     $action = /^\+$/ ? "MOVE" : "UNLINK";
  1424.     }
  1425.  
  1426.     if ($action eq "UNLINK" && ! $noop_mode)
  1427.     {
  1428.     unlink $packaged || &diagnose ("Cannot delete file \`$packaged\'");
  1429.     }
  1430.  
  1431.     if ($action eq "MOVE" && ! $noop_mode)
  1432.     {
  1433.     if (-f $file)
  1434.     {
  1435.         unlink $file || &diagnose ("Cannot delete file \`$file\'");
  1436.     }
  1437.     &prepare_filename ($file);
  1438.     system "mv $packaged $file"
  1439.         || &interrupt ("Cannot move packaged file into \`$file\'");
  1440.     $here_signature{$file} = &single_signature ($file);
  1441.     }
  1442. }
  1443.  
  1444. # $CONFIG file maintainance.
  1445.  
  1446. ## Digest in file \`$CONFIG\' if not done already.
  1447.  
  1448. sub maybe_fetch_config
  1449. {
  1450.     local (@signature, $index, $string);
  1451.  
  1452.     return if ! $fetch_config;
  1453.  
  1454.     %remote = ();
  1455.     %scan = ();
  1456.     %ignore = ();
  1457.     %signature = ();
  1458.  
  1459.     if (open (CONFIG, $CONFIG))
  1460.     {
  1461.     while (chop ($_ = <CONFIG>))
  1462.     {
  1463.         next if /^$/;
  1464.         next if /^#/;
  1465.  
  1466.         if (/^(format|version)\t$PROGRAM ([^ ]+)$/o
  1467.         ||/^($PROGRAM|version)\t([^ ]+)$/o)
  1468.         {
  1469.         &interrupt ("$CONFIG:$.: Unmatching format for $CONFIG")
  1470.             if $2 ne $FORMAT;
  1471.         }
  1472.         elsif (/^title\t(.*)$/)
  1473.         {
  1474.         $project_title = $1;
  1475.         &warn ("Reading configuration for project \`$project_title\'");
  1476.         }
  1477.         elsif (/^(here|local)\t([^ ]+) ([^ ]+)$/)
  1478.         {
  1479.         ($here_email, $here_home) = ($2, $3);
  1480.         $here_email =~ tr/A-Z/a-z/;
  1481.         $config_filename = &expand_filename ("$here_home/$CONFIG");
  1482.         }
  1483.         elsif (/^remote\t([^ ]+) ([^ ]+)$/)
  1484.         {
  1485.         $string = $1;
  1486.         $string =~ tr/A-Z/a-z/;
  1487.         $saved_save_config = $save_config;
  1488.         &create_remote ($1, $2);
  1489.         $save_config = $saved_save_config;
  1490.         }
  1491.         elsif (/^scan\t([^ ]+)$/)
  1492.         {
  1493.         $scan{$1} = 1;
  1494.         }
  1495.         elsif (/^ignore\t([^ ]+)$/)
  1496.         {
  1497.         $ignore{&convert_ignore ($1)} = 1;
  1498.         }
  1499.         elsif (/^\t([^ ]+) (.*)/)
  1500.         {
  1501.  
  1502.         # Temporary code, the time everything is getting updated.
  1503.         # Was: $signature{$1} = $2;
  1504.  
  1505.         @signature = split (/ /, $2);
  1506.         for ($index = 0; $index < @remote; $index++)
  1507.         {
  1508.             if (! $signature[$index])
  1509.             {
  1510.             &diagnose ("Empty signature for file \`$1\' [$index]");
  1511.             $signature[$index] = "-";
  1512.             $save_config = 1;
  1513.             }
  1514.         }
  1515.         $signature{$1} = join (" ", @signature);
  1516.         }
  1517.         else
  1518.         {
  1519.         &interrupt ("** $CONFIG:$.: Illegal format for $CONFIG");
  1520.         }
  1521.     }
  1522.     close CONFIG;
  1523.  
  1524.     if (! $project_title)
  1525.     {
  1526.         &diagnose ("There is no title for this project.");
  1527.         &query ("Please enter a short project description:");
  1528.         $project_title = $_;
  1529.     }
  1530.     }
  1531.     else
  1532.     {
  1533.     chop ($_ = `pwd`);
  1534.     $_ = &normalize_directory ($_);
  1535.     &diagnose ("Directory \`$_\' is not ready for synchronization");
  1536.     &query ("Should I prepare it for its first time (y/n)? [y]");
  1537.     &interrupt ("Command aborted!") if ! /^(y|yes)$/i;
  1538.     $new_config = 1;
  1539.  
  1540.     &query ("Please enter a short project description:");
  1541.     $project_title = $_;
  1542.  
  1543.     $_ = &guess_here_email;
  1544.     &query ("What is your full email address, here? [$_]");
  1545.     $here_email = $_;
  1546.  
  1547.     chop ($_ = `pwd`);
  1548.     $here_home = &normalize_directory ($_);
  1549.     $config_filename = &expand_filename ("$here_home/$CONFIG");
  1550.  
  1551.     foreach (("(.*/)?core(\\..*)?",
  1552.           ".*,v",
  1553.           ".*/RCS/.*",
  1554.           ".*\\.(bak|BAK)",
  1555.           ".*\\.[oa]",
  1556.           ".*~",
  1557.           "\\$CONFIG.*",
  1558.           "\\\#.*"))
  1559.     {
  1560.         $ignore{$_} = 1;
  1561.     }
  1562.     }
  1563.  
  1564.     $fetch_config = 0;
  1565.     $save_config = 1;
  1566.     $study_files = 1;
  1567. }
  1568.  
  1569. ## Write back file \`$CONFIG\' if it has been modified.
  1570.  
  1571. sub maybe_save_config
  1572. {
  1573.     local ($index);
  1574.  
  1575.     return if ! $save_config;
  1576.     $save_config = 0;
  1577.     return if $noop_mode;
  1578.  
  1579.     if (! $new_config)
  1580.     {
  1581.     unlink "$config_filename.bak";
  1582.     rename ("$config_filename", "$config_filename.bak")
  1583.         || &interrupt ("Cannot backup file \`$config_filename'");
  1584.     }
  1585.  
  1586.     open (CONFIG, ">$config_filename")
  1587.     || &interrupt ("Cannot create file \`$config_filename\'");
  1588.     print CONFIG
  1589.     "# This file is maintained automatically by program \`$PROGRAM\'.",
  1590.     "  DO NOT EDIT!\n";
  1591.     print CONFIG "\n";
  1592.     print CONFIG "format\t$PROGRAM $FORMAT\n";
  1593.     print CONFIG "title\t$project_title\n";
  1594.     &diagnose ("There is no project title, yet") if ! $project_title;
  1595.     print CONFIG "here\t$here_email $here_home\n";
  1596.     &diagnose ("There are no declared remote connections, yet")
  1597.     if ! @remote;
  1598.     foreach (@remote)
  1599.     {
  1600.     print CONFIG "remote\t$_ $remote{$_}\n";
  1601.     }
  1602.     print CONFIG "\n";
  1603.     foreach (sort keys %scan)
  1604.     {
  1605.     print CONFIG "scan\t$_\n";
  1606.     }
  1607.     foreach (sort keys %ignore)
  1608.     {
  1609.     print CONFIG "ignore\t$_\n";
  1610.     }
  1611.     foreach (sort keys %signature)
  1612.     {
  1613.     print CONFIG "\t", $_, " ", $signature{$_}, "\n";
  1614.     }
  1615.     close CONFIG;
  1616. }
  1617.  
  1618. ## Scan for files with \`find\' and \`sum\', unless this is done already.
  1619.  
  1620. sub maybe_study_files
  1621. {
  1622.     local ($list, $signature, $file);
  1623.  
  1624.     # Do not execute this lengthy process without reason.
  1625.  
  1626.     return if ! $study_files;
  1627.     &warn ("Studying local files for their signature");
  1628.  
  1629.     # Find the proper "sum" command.
  1630.  
  1631.     if (! $sum_command)
  1632.     {
  1633.     foreach (("sum", "sum -r"))
  1634.     {
  1635.         if (`echo x | $_` =~ /^00070 /)
  1636.         {
  1637.         $sum_command = $_;
  1638.         last;
  1639.         }
  1640.     }
  1641.     &interrupt ("Cannot find BSD program \`sum\' around")
  1642.         if ! $sum_command;
  1643.     }
  1644.  
  1645.     # Trigger execution of find with all the %scan parameters.
  1646.  
  1647.     if (%scan == 0)
  1648.     {
  1649.     $list = " .";
  1650.     }
  1651.     else
  1652.     {
  1653.     $list = "";
  1654.     foreach (sort keys %scan)
  1655.     {
  1656.         $list .= " '$_'";
  1657.     }
  1658.     }
  1659.  
  1660.     $findtempfile = `tempfile`;
  1661.     chop $findtempfile;
  1662.  
  1663.     open (SCAN, ("find$list -type f -print 2> $findtempfile"
  1664.          . " | xargs $sum_command |"))
  1665.     || &interrupt ("Cannot launch program \`find\'");
  1666.  
  1667.     # Process each existing file in turn.
  1668.  
  1669.     %here_signature = ();
  1670.     $maximum_name_width = 0;
  1671.  
  1672.     while (<SCAN>)
  1673.     {
  1674.     if (/^([0-9]+) +[0-9]+ +(\.\/)?(.*)/)
  1675.     {
  1676.         ($signature, $file) = ($1, $3);
  1677.     }
  1678.     else
  1679.     {
  1680.         chop;
  1681.         &diagnose ("Unrecognized output from program \`sum\': \`$_\'");
  1682.         next;
  1683.     }
  1684.  
  1685.     next if &ignorable_file ($file);
  1686.  
  1687.     $here_signature{$file} = $signature;
  1688.     $maximum_name_width = length $file
  1689.         if length $file > $maximum_name_width;
  1690.     }
  1691.     close SCAN;
  1692.  
  1693.     # Clean out scanning for inexisting files.
  1694.  
  1695.     open (SCAN, "$findtempfile");
  1696.     while (<SCAN>)
  1697.     {
  1698.     chop;
  1699.     if (/^find: (.*): No such file or directory$/)
  1700.     {
  1701.         $file = $1;
  1702.         &diagnose ("No files found while scanning for \`$file\'");
  1703.         if (! defined $scan{$file})
  1704.         {
  1705.         &diagnose ("And this is not even a valid scan.  Bizarre...");
  1706.         }
  1707.         elsif ($scan{$file} != $NEWLY_CREATED_SCAN)
  1708.         {
  1709.         &query ("Should I delete this scan (y/n)? [y]");
  1710.         if (/^(y|yes)$/i)
  1711.         {
  1712.             &command_delete_scan ($file);
  1713.         }
  1714.         else
  1715.         {
  1716.             &diagnose ("Please ensure some local file exists for it!");
  1717.         }
  1718.         }
  1719.     }
  1720.     else
  1721.     {
  1722.         &diagnose ("Scan error: $_");
  1723.     }
  1724.     }
  1725.     close SCAN;
  1726.     unlink "$findtempfile";
  1727.  
  1728.     $study_files = 0;
  1729. }
  1730.  
  1731. ## Compute \`sum\' over a single file.
  1732.  
  1733. sub single_signature
  1734. {
  1735.     (split (" ", `$sum_command $_[0]`))[0];
  1736. }
  1737.  
  1738. ## Update file and signature matrix according to what exists here.
  1739.  
  1740. sub update_file_registry
  1741. {
  1742.     local ($cautious);
  1743.  
  1744.     foreach (sort keys %signature)
  1745.     {
  1746.     if (! defined $here_signature{$_})
  1747.     {
  1748.         &warn ("Unregistering file \`$_\'");
  1749.         delete $signature{$_};
  1750.         $save_config = 1;
  1751.     }
  1752.     }
  1753.  
  1754.     foreach (sort keys %here_signature)
  1755.     {
  1756.     if (! defined $signature{$_})
  1757.     {
  1758.         &warn ("Registering file \`$_\'");
  1759.         $signature{$_} = join (" ", ("-") x @remote);
  1760.         $save_config = 1;
  1761.         $cautious = 1;
  1762.     }
  1763.     }
  1764.  
  1765.     if ($cautious && !$process_loop)
  1766.     {
  1767.     &diagnose ("There were new registrations, please check them");
  1768.     &query ("Should I resume the current command (y/n)? [y]");
  1769.     &interrupt ("Command aborted!") if ! /^(y|yes)$/i;
  1770.     }
  1771. }
  1772.  
  1773. # Identification and filename services.
  1774.  
  1775. ## Return a sensible suggestion for our probable email address.
  1776.  
  1777. sub guess_here_email
  1778. {
  1779.     return $here_email if $here_email;
  1780.  
  1781.     chop ($_ = `hostname`);
  1782.     if (/\./)
  1783.     {
  1784.     $_ = "$ENV{'LOGNAME'}@$_";
  1785.     }
  1786.     else
  1787.     {
  1788.     $_ .= "!$ENV{'LOGNAME'}";
  1789.     }
  1790.     tr/A-Z/a-z/;
  1791.     return $_;
  1792. }
  1793.  
  1794. ## Use forgiving rules to test for equivalence between EMAIL_LEFT
  1795. ## and EMAIL_RIGHT.
  1796.  
  1797. sub equivalent_email
  1798. {
  1799.     local ($email_left, $email_right) = @_;
  1800.     local ($user_left, $user_right, $domain_left, $domain_right);
  1801.  
  1802.     if ($email_left =~ /(.+)@(.+)/)
  1803.     {
  1804.     ($user_left, $domain_left) = ($1, $2);
  1805.     }
  1806.     elsif ($email_left =~ /(.+)!([^!]+)/)
  1807.     {
  1808.     ($user_left, $domain_left) = ($2, $1);
  1809.     }
  1810.     else
  1811.     {
  1812.     ($user_left, $domain_left) = ($email_left, "");
  1813.     }
  1814.  
  1815.     if ($email_right =~ /(.+)@(.+)/)
  1816.     {
  1817.     ($user_right, $domain_right) = ($1, $2);
  1818.     }
  1819.     elsif ($email_right =~ /(.+)!([^!]+)/)
  1820.     {
  1821.     ($user_right, $domain_right) = ($2, $1);
  1822.     }
  1823.     else
  1824.     {
  1825.     ($user_right, $domain_right) = ($email_right, "");
  1826.     }
  1827.  
  1828.     $domain_left =~ s/\.uucp$//;
  1829.     $domain_right =~ s/\.uucp$//;
  1830.  
  1831.     return 0 if ($user_left !~ /^$user_right(-batch)?$/
  1832.          && $user_right !~ /^$user_left(-batch)?$/);
  1833.  
  1834.     return 0 if ($domain_left !~ /$domain_right$/
  1835.          && $domain_right !~ /$domain_left$/);
  1836.     1;
  1837. }
  1838.  
  1839. ## Return the given filename expanded so the system will recognize it.
  1840.  
  1841. sub expand_filename
  1842. {
  1843.     local ($pwd);
  1844.  
  1845.     $_ = @_[0];
  1846.     if (/^~/)
  1847.     {
  1848.     return $ENV{"HOME"} if /^~$/;
  1849.     s|^~/|$ENV{"HOME"}/|;
  1850.     }
  1851.     return $_ if /^\//;
  1852.  
  1853.     chop ($pwd = `pwd`);
  1854.     "$pwd/$_";
  1855. }
  1856.  
  1857. ## Return the given directory normalized so the user will like
  1858. ## it more.  However, still avoid relative notations.
  1859.  
  1860. sub normalize_directory
  1861. {
  1862.     return "~" if $_[0] eq $ENV{"HOME"};
  1863.  
  1864.     $_ = $_[0];
  1865.     s|^$ENV{"HOME"}/|~/|;
  1866.     chop ($_ = `cd $_; pwd`) if ! /^[~\/]/;
  1867.     $_;
  1868. }
  1869.  
  1870. ## Ensure intermediate directories exist by creating them as needed,
  1871. ## and that the appropriate permissions are set for the FILE to be
  1872. ## created or replaced.
  1873.  
  1874. sub prepare_filename
  1875. {
  1876.     local ($filename) = @_;
  1877.     local (@filename, $counter);
  1878.  
  1879.     if (-e $filename)
  1880.     {
  1881.     &interrupt ("Cannot modify read-only file \`$filename\'")
  1882.         if ! -w $filename;
  1883.     return;
  1884.     }
  1885.  
  1886.     @filename = split (/\//, $filename);
  1887.     pop @filename;
  1888.  
  1889.     for ($counter = $filename[0] ? 0 : 1; $counter < @filename; $counter++)
  1890.     {
  1891.     $filename = join ("/", @filename[0 .. $counter]);
  1892.     next if -d $filename;
  1893.     &warn ("  Creating new directory \`$filename\'");
  1894.     if (! mkdir ($filename, 0755))
  1895.     {
  1896.         &interrupt ("Cannot create directory \`$filename\'");
  1897.         return;
  1898.     }
  1899.     }
  1900. }
  1901.  
  1902. # Various services.
  1903.  
  1904. ## Convert IGNORE from previous "local" format to current "here" format.
  1905. ## This routine is meant to disappear soon after everything stabilized.
  1906.  
  1907. sub convert_ignore
  1908. {
  1909.     $_ = $_[0];
  1910.  
  1911.     if (/^[\^\/](.*)/ || /(.*)[\$\/]$/)
  1912.     {
  1913.     if (/^\^(.*)/)
  1914.     {
  1915.         $_ = $1;
  1916.     }
  1917.     else
  1918.     {
  1919.         $_ = ".*$_";
  1920.     }
  1921.  
  1922.     if (/(.*)\$$/)
  1923.     {
  1924.         $_ = $1;
  1925.     }
  1926.     else
  1927.     {
  1928.         $_ = "$_.*";
  1929.     }
  1930.     $save_config = 1;
  1931.     }
  1932.  
  1933.     return $_;
  1934. }
  1935.  
  1936. ## Says whether if FILE should be ignored.
  1937.  
  1938. sub ignorable_file
  1939. {
  1940.     local ($file) = @_;
  1941.  
  1942.     foreach (keys %ignore)
  1943.     {
  1944.     if (/^!(.*)/)
  1945.     {
  1946.         return 1 if $file !~ /^$1$/;
  1947.     }
  1948.     else
  1949.     {
  1950.         return 1 if $file =~ /^$_$/;
  1951.     }
  1952.     }
  1953.     0;
  1954. }
  1955.  
  1956. ## Initialize @site_set according to the given SET.
  1957.  
  1958. sub decode_site_set
  1959. {
  1960.     local ($set) = @_;
  1961.     local ($index, $counter);
  1962.  
  1963.     if ($set eq "")
  1964.     {
  1965.     @site_set = 0 .. @remote - 1;
  1966.     }
  1967.     elsif ($set eq "!")
  1968.     {
  1969.     @site_set = ();
  1970.     }
  1971.     elsif ($set =~ /!(.*)/)
  1972.     {
  1973.     @site_set = 0 .. @remote - 1;
  1974.     foreach (split (" ", $1))
  1975.     {
  1976.         $site_set[&validated_remote_index ($_)] = "";
  1977.     }
  1978.     @site_set = grep (/./, @site_set);
  1979.     }
  1980.     else
  1981.     {
  1982.     @site_set = ();
  1983.     @copy_list = ();    # used to parallel "from" and "check" lines
  1984.     $counter = 0;
  1985.     foreach (split (" ", $set))
  1986.     {
  1987.         $index = &validated_remote_index ($_);
  1988.         $copy_list[$counter++] = $index;
  1989.         $site_set[$index] = $index;
  1990.     }
  1991.     @site_set = grep (/./, @site_set);
  1992.     }
  1993. }
  1994.  
  1995. ## Create a new REMOTE address with its related DIRECTORY.
  1996.  
  1997. sub create_remote
  1998. {
  1999.     local ($remote, $directory) = @_;
  2000.  
  2001.     push (@remote, $remote);
  2002.     $remote{$remote} = $directory;
  2003.     foreach (keys %signature)
  2004.     {
  2005.     $signature{$_} .= " -";
  2006.     }
  2007.     $save_config = 1;
  2008. }
  2009.  
  2010. ## Alter a REMOTE address to a NEW_REMOTE address, known to be equivalent.
  2011.  
  2012. sub change_remote
  2013. {
  2014.     local ($remote, $new_remote) = @_;
  2015.  
  2016.     return if $remote eq $new_remote;
  2017.     $remote[&validated_remote_index ($remote)] = $new_remote;
  2018.     $remote{$new_remote} = $remote{$remote};
  2019.     delete $remote{$remote};
  2020.     $save_config = 1;
  2021. }
  2022.  
  2023. ## Destroy information related to a REMOTE address.
  2024.  
  2025. sub delete_remote
  2026. {
  2027.     local ($remote) = @_;
  2028.     local ($index);
  2029.  
  2030.     $index = &validated_remote_index ($remote);
  2031.     @remote = @remote[0 .. $index - 1, $index + 1 .. @remote - 1];
  2032.     delete $remote{$remote};
  2033.  
  2034.     foreach (keys %signature)
  2035.     {
  2036.     @signature = split (/ /, $signature{$_});
  2037.     $signature{$_} = join (" ", @signature[0 .. $index - 1,
  2038.                            $index + 1 .. @signature - 1]);
  2039.     }
  2040.     $save_config = 1;
  2041. }
  2042.  
  2043. ## Return the index of a given REMOTE, interrupting the command if not found.
  2044.  
  2045. sub validated_remote_index
  2046. {
  2047.     local ($remote) = @_;
  2048.     local ($index);
  2049.  
  2050.     $index = &remote_index ($remote);
  2051.     return $index if $index >= 0;
  2052.     &interrupt ("Specification \`$remote\' invalid for remote address");
  2053. }
  2054.  
  2055. ## Return the index of a given REMOTE, or a negative value if not found.
  2056.  
  2057. sub remote_index
  2058. {
  2059.     local ($remote) = @_;
  2060.     local ($index);
  2061.  
  2062.     $remote = @remote[$remote - 1] if ($remote > 0 && $remote <= @remote);
  2063.     $index = 0;
  2064.     foreach (@remote)
  2065.     {
  2066.     return $index if $remote eq $_;
  2067.     $index++;
  2068.     }
  2069.     -1;
  2070. }
  2071.  
  2072. # Interactive dialog and error processing.
  2073.  
  2074. ## Query the user interactively with QUESTION, return the reply
  2075. ## in $_.  An empty reply means the default signature from the QUESTION
  2076. ## if any, written as "...? [DEFAULT]".  Echo the input if used
  2077. ## in process.
  2078.  
  2079. sub query
  2080. {
  2081.     local ($query) = @_;
  2082.  
  2083.     while (1)
  2084.     {
  2085.     print STDERR "\a$query ";
  2086.     $_ = <>;
  2087.     if ($_)
  2088.     {
  2089.         print STDERR if ! -t;
  2090.         chop;
  2091.         if (/^\?$/)
  2092.         {
  2093.         print STDERR $NORMAL_HELP;
  2094.         next;
  2095.         }
  2096.         if (/^! *(.*)$/)
  2097.         {
  2098.         if ($1)
  2099.         {
  2100.             system $1;
  2101.         }
  2102.         elsif (defined $ENV{$SHELL})
  2103.         {
  2104.             system $ENV{$SHELL};
  2105.         }
  2106.         else
  2107.         {
  2108.             system $SH;
  2109.         }
  2110.         next;
  2111.         }
  2112.         if (/^abort$/)
  2113.         {
  2114.         if ($save_config)
  2115.         {
  2116.             &diagnose
  2117.             ("Modifications to file \`$CONFIG\' are unsaved");
  2118.             &query ("Should I stop without saving them (y/n)? [n]");
  2119.             if (/^(y|yes)$/i)
  2120.             {
  2121.             $command_loop = 0;
  2122.             $process_loop = 0;
  2123.             &interrupt ("Program aborted!");
  2124.             }
  2125.         }
  2126.         &interrupt ("Command aborted!");
  2127.         }
  2128.         $_ = $1 if (! $_ && $query =~ /\? \[(.+)\]$/);
  2129.         return;
  2130.     }
  2131.     else
  2132.     {
  2133.         print STDERR "quit\n";
  2134.         $_ = "quit";
  2135.         return;
  2136.     }
  2137.     }
  2138. }
  2139.  
  2140. ## Issue a message for the (possibly interactive) user.
  2141.  
  2142. sub warn
  2143. {
  2144.     warn "  $_[0]\n";
  2145. }
  2146.  
  2147. ## Issue an error message for the (possibly interactive) user.
  2148.  
  2149. sub diagnose
  2150. {
  2151.     warn "* $_[0]\n";
  2152. }
  2153.  
  2154. ## Issue an error message for the (possibly interactive) user, while
  2155. ## interrupting the command being currently executed.  Abort if none.
  2156.  
  2157. sub interrupt
  2158. {
  2159.     if ($process_loop)
  2160.     {
  2161.     $workdir_to_unlink = "";
  2162.     $archive_to_unlink = "";
  2163.     %signature_received = ();
  2164.  
  2165.     warn "* $_[0]\n";
  2166.     last PROCESS_LOOP;
  2167.     }
  2168.     elsif ($command_loop)
  2169.     {
  2170.     warn "* $_[0]\n";
  2171.     next COMMAND_LOOP;
  2172.     }
  2173.     else
  2174.     {
  2175.     die "** $_[0]\n";
  2176.     }
  2177. }
  2178.  
  2179. # Local Variables:
  2180. # mode: perl
  2181. # End:
  2182.